home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / forge20.zip / EXTPROC1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  2KB  |  133 lines
  1.   Procedure Window(Win: Integer);
  2.  
  3.   Begin
  4.       TextBackground(Wtab[Win,2]);
  5.       If Wtab[Win,3] = 78 Then
  6.         TextColor(Wtab[Win,1])
  7.       Else
  8.         TextColor(Wtab[Win,1] + Blink);
  9.       MinX:= Wtab[Win,4];
  10.       MinY:= Wtab[Win,5];
  11.       MaxX:= Wtab[Win,6];
  12.       MaxY:= Wtab[Win,7];
  13.       X:= MinX-1;
  14.       Y:= MinY;
  15.       XY:= (Y-1)*80+X;
  16.       GotoXY(X,Y);
  17.       End;
  18.  
  19.  
  20. Procedure BackTab;
  21.  
  22. Begin
  23.   Sound(Tone);
  24.   Delay(40);
  25.   NoSound;
  26.   Entry_Field:= Entry_Field - 1;
  27.   If Entry_Field < 1 Then Entry_Field:= Windows;
  28.   Window(Entry_Field);
  29.   X:= MaxX;
  30.   Y:= MaxY;
  31.   XY:= (Y-1)*80+X;
  32.   GotoXY(X,Y);
  33.   End;
  34.  
  35.  
  36. Procedure Tab; Forward;
  37.  
  38.  
  39. Procedure Rt1;
  40.  
  41. Var
  42.   EF:  Integer;     { End of Field }
  43.  
  44. Begin
  45.   EF:= (MaxY-1)*80 + MaxX;
  46.   X:= X + 1;
  47.   If X > 80 Then Begin
  48.     X:= 1;
  49.     Y:= Y + 1;
  50.     End;
  51.   GotoXY(X,Y);
  52.   XY:= (Y-1)*80+X;
  53.   If XY > EF Then Begin
  54.     Tab;
  55.     GotoXY(X,Y);
  56.     End;
  57.   End;
  58.  
  59.  
  60. Procedure LT1;
  61.  
  62. Var
  63.   BF:  Integer;    { beginning of field }
  64.  
  65. Begin
  66.   X:= X - 1;
  67.   Bf:= (MinY-1)*80 + MinX;
  68.   If X < 1 Then
  69.     Begin
  70.     X:= 80;
  71.     Y:= Y - 1;
  72.     End;
  73.   GotoXY(X,Y);
  74.   XY:= (Y-1)*80+X;
  75.   If XY < BF Then BackTab;
  76.   End;
  77.  
  78.  
  79. Procedure Tab;
  80.  
  81. Begin
  82.   Sound(Tone);
  83.   Delay(40);
  84.   NoSound;
  85.   Entry_Field:= Entry_Field + 1;
  86.   If Entry_Field > Windows Then Entry_Field:= 1;
  87.   Window(Entry_Field);
  88.   Rt1;
  89.   End;
  90.  
  91.  
  92. Procedure Write_It_In_A_Field (AnyString: Str255);
  93. Begin
  94.   For i:= 1 to Length(AnyString) Do Begin
  95.     ScrBuf[XY]:= Copy (AnyString, i, 1);
  96.     Write (Copy (AnyString, i, 1));
  97.     XY:= XY+1;
  98.     End;
  99.   End;  { Procedure Write_It_In_A_Field }
  100.  
  101.  
  102.  
  103. Procedure Blank_Fields;
  104.  
  105. Var
  106.   LOF: Integer;   { Length_Of_Field }
  107.  
  108. Begin
  109.   Entry_Field:= 0;
  110.   Tone:= 0;
  111.   For k:= 0 to Windows Do Begin
  112.     Tab;
  113.     LOF:= ((MaxY-1)*80 + MaxX) - ((MinY-1)*80 + MinX) + 1;
  114.     For i:= 1 to LOF Do Begin
  115.       ScrBuf[XY]:= Chr(32);
  116.       Write(Chr(32));
  117.       XY:= XY+1;
  118.       End;
  119.     End;
  120.   End;
  121.  
  122.  
  123. Procedure Banner_Line;
  124.  
  125. Begin
  126.   GotoXY(2,25);
  127.   TextColor(Black);
  128.   TextBackground(LightGray);
  129.   For i:= 1 to 78 Do Write(Chr(32));
  130.   GotoXY(2,25);
  131.   Write(' f1=Quit f2=Prev f3=Next f4=Del f5=Rec#      f8=Backup f0=Accept Record #');
  132. End; { procedure banner_line }
  133.